Shareware Grab Bag/Shareware Grab Bag.iso/007/rascal.arc/TEST.BAS

BASIC Source File | 1985-08-03 | 18KB | 554 lines

  10  'CHARS.RAS   8-03-85   2:27p  464 lines
  12  GOSUB 70
  20  GOSUB 4170
  30  END
  40  'CHARS.RAS: Display all the PC's screen characters, modified from
  50  '           Peter Norton's book.
  60  'Rascal Program Debugger, version 1.00  (C) Copyright 1983 Marty Franz
  70  'PROCEDURE DEBUG.SETUP
  80  'Set up stack of procedure names
  90  DB.NPROCS = 10
 100  DIM DB.LABEL$(DB.NPROCS),DB.LINE(DB.NPROCS)
 110  'Set up cursor and output variables
 120  DB.STATUS.LINE = 25
 130  DB.CUROFF = 0 : DB.CURON = 1
 140  DB.BLINK = 5 : DB.CURCNT = DB.BLINK
 150  DB.CURSOR$ = CHR$(&H5F)
 160  DB.BKSP$ = CHR$(8)
 170  DB.RET$ = CHR$(13)
 180  DB.TLBOX$ = CHR$(&HC9) : DB.TRBOX$ = CHR$(&HBB)
 190  DB.BLBOX$ = CHR$(&HC8) : DB.BRBOX$ = CHR$(&HBC)
 200  DB.TOP$ = CHR$(&HCD)   : DB.SIDE$ = CHR$(&HBA)
 210  DB.MASK$ = "\                              \"
 220  'String for proofing labels input as breakpoints
 230  DB.LABCHRS$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789."
 240  'Establish error and key trapping (F10 stops debugger)
 250  ON ERROR GOTO 370
 260  ON KEY(10) GOSUB 410
 270  KEY OFF
 280  KEY (10) ON
 290  DB.LEVEL = 0                'No procedures entered yet
 300  DB.BPOINT = 0                'No breakpoints in effect
 310  DB.CMDSTOP = 0                'No command keyboard stops
 320  GOSUB 440
 330  GOSUB 2340
 340  GOSUB 2290
 350  GOSUB 1110
 360  RETURN
 370  'Error routine for BASIC errors 'DB.BASIC.ERROR|
 380  GOSUB 610
 390  GOSUB 1110
 400  RESUME
 410  'PROCEDURE DEBUG.KEYBD.STOP        'Entered when F10 pressed
 420  DB.CMDSTOP = 1
 430  RETURN
 440  'PROCEDURE DEBUG.HELLO            'Tell user available functions
 450  CLS
 460  PRINT "Rascal Program Debugger active..."
 470  PRINT
 480  PRINT "You can enter the debugger by:"
 490  PRINT
 500  PRINT "   1. Pressing F10 during program execution,"
 510  PRINT "   2. Setting a procedure breakpoint with the B command,"
 520  PRINT "   3. Your program causing a BASIC error."
 530  PRINT
 540  PRINT "In the debugger, you can type:"
 550  PRINT
 560  PRINT "   X  to exit into BASIC (type CONT to go back),"
 570  PRINT "   D  to list the Rascal procedures called,"
 580  PRINT "   B  to set a procedure breakpoint,"
 590  PRINT "   G  to resume your program's execution"
 600  RETURN
 610  'PROCEDURE DEBUG.BASIC.ERROR        'Process BASIC errors
 620  COLOR 15,0
 630  LOCATE DB.STATUS.LINE,1,CUROFF
 640  PRINT USING "##### ";ERL;
 650  DB.ERROR = ERR
 660  IF NOT(DB.ERROR > 77) THEN 680
 670  DB.ERROR = 77
 680  GOSUB 720
 690  LOCATE ,,CURON
 700  COLOR 7,0
 710  RETURN
 720  'PROCEDURE DEBUG.ERROR.MSG        'Decode BASIC error msg
 730  RESTORE 2400
 740  READ DB.ERR.KEY,DB.ERROR.MSG$
 750  IF NOT(DB.ERR.KEY = DB.ERROR) THEN 770
 760  GOTO 780
 770  IF NOT(DB.ERR.KEY = 77) THEN 740
 780  PRINT USING DB.MASK$;DB.ERROR.MSG$
 790  RETURN
 800  'PROCEDURE DEBUG.PROC            'Handle procedure call
 810  GOSUB 2340
 820  DB.LEVEL = DB.LEVEL + 1
 830  DB.LABEL$(DB.LEVEL) = DEBUG.LABEL$
 840  DB.LINE(DB.LEVEL) = DEBUG.LINE
 850  GOSUB 1000
 860  IF NOT(DB.BPOINT = 1 AND DB.BPLABEL$ = DEBUG.LABEL$) THEN 880
 870  DB.CMDSTOP = 1
 880  IF NOT(DB.CMDSTOP = 1) THEN 920
 890  GOSUB 2240
 900  GOSUB 1110
 910  DB.CMDSTOP = 0
 920  GOSUB 2370
 930  RETURN
 940  'PROCEDURE DEBUG.ENDP            'Handle procedure exit
 950  GOSUB 2340
 960  DB.LEVEL = DB.LEVEL - 1
 970  GOSUB 1000
 980  GOSUB 2370
 990  RETURN
1000  'PROCEDURE DEBUG.TRACE.MSG        'Display procedure and line
1010  COLOR 15,0
1020  LOCATE DB.STATUS.LINE,1,CUROFF
1030  IF NOT(DB.LEVEL > 0) THEN 1070
1040  PRINT USING "##### ";DB.LINE(DB.LEVEL);
1050  PRINT USING DB.MASK$;DB.LABEL$(DB.LEVEL);
1060  GOTO 1080
1070  PRINT USING DB.MASK$;"Exit";
1080  LOCATE ,,CURON
1090  COLOR 7,0
1100  RETURN
1110  'PROCEDURE DEBUG.CMD                'Get and process commands
1120  DB.DONE = 0
1130  GOSUB 1180
1140  GOSUB 1250
1150  IF NOT(DB.DONE = 1) THEN 1130
1160  GOSUB 2240
1170  RETURN
1180  'PROCEDURE DEBUG.GET.CMD         'Get and proof debugger command
1190  GOSUB 2240
1200  PRINT "debug: ";
1210  GOSUB 1900
1220  DB.ISKEY = INSTR("BDGX",DB.KEY$)
1230  IF NOT(DB.ISKEY > 0) THEN 1210
1240  RETURN
1250  'PROCEDURE DEBUG.DO.CMD            'Call procedure for each command
1260  IF NOT(DB.KEY$ = "G") THEN 1290
1270  DB.DONE = 1
1280  GOTO 1390
1290  IF NOT(DB.KEY$ = "X") THEN 1320
1300  GOSUB 1400
1310  GOTO 1390
1320  IF NOT(DB.KEY$ = "B") THEN 1350
1330  GOSUB 1460
1340  GOTO 1390
1350  IF NOT(DB.KEY$ = "D") THEN 1380
1360  GOSUB 1560
1370  GOTO 1390
1380  BEEP
1390  RETURN
1400  'PROCEDURE DEBUG.DO.STOP         'Handle exit to BASIC
1410  PRINT "exit to BASIC";
1420  GOSUB 2370
1430  PRINT : PRINT "Type CONT to go back to debugger..."
1440  STOP
1450  RETURN
1460  'PROCEDURE DEBUG.DO.BPOINT        'Set breakpoint
1470  GOSUB 2240
1480  PRINT "breakpoint: ";
1490  GOSUB 1740
1500  DB.BPLABEL$ = DB.INPUT$
1510  IF NOT(LEN(DB.BPLABEL$) > 0) THEN 1540
1520  DB.BPOINT = 1
1530  GOTO 1550
1540  DB.BPOINT = 0
1550  RETURN
1560  'PROCEDURE DEBUG.DO.DUMP         'Dump stack of procedure calls
1570  PRINT "dump procedure stack";
1580  LOCATE 1,38
1590  PRINT DB.TLBOX$;
1600  FOR DB.I = 1 TO 40 : PRINT DB.TOP$; : NEXT DB.I
1610  PRINT DB.TRBOX$
1620  FOR DB.I = DB.LEVEL TO 1 STEP -1
1630  LOCATE ,38
1640  PRINT DB.SIDE$;" ";
1650  PRINT USING "##### ";DB.LINE(DB.I);
1660  PRINT USING DB.MASK$;DB.LABEL$(DB.I);
1670  PRINT " ";DB.SIDE$
1680  NEXT DB.I
1690  LOCATE ,38
1700  PRINT DB.BLBOX$;
1710  FOR DB.I = 1 TO 40 : PRINT DB.TOP$; : NEXT DB.I
1720  PRINT DB.BRBOX$;
1730  RETURN
1740  'PROCEDURE DEBUG.GET.STRING        'Get label name for breakpoint
1750  DB.INPUT$ = ""
1760  DB.START.COL = POS(0)
1770  GOSUB 1900
1780  IF NOT(DB.KEY$ = DB.RET$) THEN 1810
1790  GOTO 1890
1800  GOTO 1880
1810  IF NOT(DB.KEY$ = DB.BKSP$) THEN 1840
1820  GOSUB 2040
1830  GOTO 1880
1840  IF NOT(INSTR(DB.LABCHRS$,DB.KEY$) > 0) THEN 1870
1850  GOSUB 1970
1860  GOTO 1880
1870  BEEP
1880  IF NOT(1 = 0) THEN 1770
1890  RETURN
1900  'PROCEDURE DEBUG.GET.KEY         'Get uppercase key from keyboard
1910  GOSUB 2130
1920  DB.KEY$ = INKEY$
1930  IF NOT(LEN(DB.KEY$) > 0) THEN 1910
1940  IF NOT(ASC(DB.KEY$) > 96 AND ASC(DB.KEY$) < 123) THEN 1960
1950  DB.KEY$ = CHR$(ASC(DB.KEY$) - 32)
1960  RETURN
1970  'PROCEDURE DEBUG.INS.CHAR        'Add char to end of breakpoint label
1980  IF NOT(POS(0) < 79) THEN 2020
1990  PRINT DB.KEY$;
2000  DB.INPUT$ = DB.INPUT$ + DB.KEY$
2010  GOTO 2030
2020  BEEP
2030  RETURN
2040  'PROCEDURE DEBUG.DEL.CHAR        'Handle backspace key in input
2050  DB.CUR.COL = POS(0)
2060  IF NOT(DB.CUR.COL > DB.START.COL) THEN 2110
2070  DB.INPUT$ = LEFT$(DB.INPUT$,LEN(DB.INPUT$)-1)
2080  PRINT " ";
2090  LOCATE ,DB.CUR.COL-1
2100  GOTO 2120
2110  BEEP
2120  RETURN
2130  'PROCEDURE DEBUG.CURSOR            'Simulate BASIC cursor
2140  IF NOT(DB.CURCNT = DB.BLINK) THEN 2200
2150  IF NOT(DB.CURCHAR$ = DB.CURSOR$) THEN 2180
2160  DB.CURCHAR$ = " "
2170  GOTO 2190
2180  DB.CURCHAR$ = DB.CURSOR$
2190  DB.CURCNT = 0
2200  PRINT DB.CURCHAR$;
2210  DB.CURCNT = DB.CURCNT + 1
2220  LOCATE ,POS(0)-1
2230  RETURN
2240  'PROCEDURE DEBUG.CLR.CMD         'Clear command area of status line
2250  LOCATE DB.STATUS.LINE,40,CUROFF
2260  PRINT SPACE$(40);
2270  LOCATE DB.STATUS.LINE,40,CURON
2280  RETURN
2290  'PROCEDURE DEBUG.CLR.MSG         'Clear message area of status line
2300  LOCATE DB.STATUS.LINE,1,CUROFF
2310  PRINT SPACE$(40);
2320  LOCATE DB.STATUS.LINE,1,CURON
2330  RETURN
2340  'PROCEDURE DEBUG.PUSH.CURSOR        'Save program's cursor
2350  DB.ROW = CSRLIN : DB.COL = POS(0)
2360  RETURN
2370  'PROCEDURE DEBUG.POP.CURSOR        'Restore program's cursor
2380  LOCATE DB.ROW,DB.COL
2390  RETURN
2400  'Table of BASIC error messages 'DB.ERROR.MSGS|
2410  DATA  1,"NEXT without FOR"
2420  DATA  2,"Syntax error"
2430  DATA  3,"RETURN without GOSUB"
2440  DATA  4,"Out of data"
2450  DATA  5,"Illegal function call"
2460  DATA  6,"Overflow"
2470  DATA  7,"Out of memory"
2480  DATA  8,"Undefined line number"
2490  DATA  9,"Subscript out of range"
2500  DATA 10,"Duplicate definition"
2510  DATA 11,"Division by zero"
2520  DATA 12,"Illegal direct"
2530  DATA 13,"Type mismatch"
2540  DATA 14,"Out of string space"
2550  DATA 15,"String too long"
2560  DATA 16,"String formula too complex"
2570  DATA 17,"Can't continue"
2580  DATA 18,"Undefined user function"
2590  DATA 19,"No RESUME"
2600  DATA 20,"RESUME without error"
2610  DATA 22,"Missing operand"
2620  DATA 23,"Line buffer overflow"
2630  DATA 24,"Device timeout"
2640  DATA 25,"Device fault"
2650  DATA 26,"FOR without NEXT"
2660  DATA 27,"Out of paper"
2670  DATA 29,"WHILE without WEND"
2680  DATA 30,"WEND without WHILE"
2690  DATA 50,"FIELD overflow"
2700  DATA 51,"Internal error"
2710  DATA 52,"Bad file number"
2720  DATA 53,"File not found"
2730  DATA 54,"Bad file mode"
2740  DATA 55,"File already open"
2750  DATA 57,"Device I/O error"
2760  DATA 58,"File already exists"
2770  DATA 61,"Disk full"
2780  DATA 62,"Input past end"
2790  DATA 63,"Bad record number"
2800  DATA 64,"Bad file name"
2810  DATA 66,"Direct statement in file"
2820  DATA 67,"Too many files"
2830  DATA 68,"Device unavailable"
2840  DATA 69,"Communication buffer overflow"
2850  DATA 70,"Disk Write Protect"
2860  DATA 71,"Disk not ready"
2870  DATA 72,"Disk media error"
2880  DATA 73,"Advanced feature"
2890  DATA 74,"Rename across disks"
2900  DATA 75,"Path/file access error"
2910  DATA 76,"Path not found"
2920  DATA 77,"Unprintable error"
2930  'INPUT.INC: Some input routines that make life easier
2940  '            (C) Copyright 1983 Marty Franz
2950  'PROCEDURE INITIALIZE.INPUT        'Initialize cursor and proof string
2951  DEBUG.LINE = 2950 : DEBUG.LABEL$ = "INITIALIZE.INPUT"
2952  GOSUB 800
2960  IN.CHAR$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890 "
2970  IN.BLINK = 5 : IN.CURCNT = IN.BLINK
2971  DEBUG.LINE = 2980
2972  GOSUB 940
2980  RETURN
2990  'PROCEDURE GET.YES.OR.NO            'Get a yes or no answer from user
2991  DEBUG.LINE = 2990 : DEBUG.LABEL$ = "GET.YES.OR.NO"
2992  GOSUB 800
3000  'ANSWER contains either YES (1) or NO (0) on exit.
3010  IN.GOTIT = 0 : YES = 1 : NO = 0
3020  GOSUB 3280
3030  IF NOT(IN.KEY$ = "Y") THEN 3070
3040  IN.GOTIT = 1
3050  ANSWER = YES
3060  GOTO 3100
3070  IF NOT(IN.KEY$ = "N") THEN 3100
3080  IN.GOTIT = 1
3090  ANSWER = NO
3100  IF NOT(IN.GOTIT = 1) THEN 3020
3101  DEBUG.LINE = 3110
3102  GOSUB 940
3110  RETURN
3120  'PROCEDURE GET.STRING            'Get label name for breakpoint
3121  DEBUG.LINE = 3120 : DEBUG.LABEL$ = "GET.STRING"
3122  GOSUB 800
3130  IN.INPUT$ = ""
3140  IN.START.COL = POS(0)
3150  GOSUB 3280
3160  IF NOT(IN.KEY$ = CHR$(13)) THEN 3190
3170  GOTO 3270
3180  GOTO 3260
3190  IF NOT(IN.KEY$ = CHR$(8)) THEN 3220
3200  GOSUB 3390
3210  GOTO 3260
3220  IF NOT(INSTR(IN.CHARS$,IN.KEY$) > 0) THEN 3250
3230  GOSUB 3350
3240  GOTO 3260
3250  BEEP
3260  IF NOT(1 = 0) THEN 3150
3261  DEBUG.LINE = 3270
3262  GOSUB 940
3270  RETURN
3280  'PROCEDURE IN.GET.KEY             'Get uppercase key from keyboard
3281  DEBUG.LINE = 3280 : DEBUG.LABEL$ = "IN.GET.KEY"
3282  GOSUB 800
3290  GOSUB 3480
3300  IN.KEY$ = INKEY$
3310  IF NOT(LEN(IN.KEY$) > 0) THEN 3290
3320  IF NOT(ASC(IN.KEY$) > 96 AND ASC(IN.KEY$) < 123) THEN 3340
3330  IN.KEY$ = CHR$(ASC(IN.KEY$) - 32)
3331  DEBUG.LINE = 3340
3332  GOSUB 940
3340  RETURN
3350  'PROCEDURE IN.INS.CHAR            'Add char to end of input string
3351  DEBUG.LINE = 3350 : DEBUG.LABEL$ = "IN.INS.CHAR"
3352  GOSUB 800
3360  PRINT IN.KEY$;
3370  IN.INPUT$ = IN.INPUT$ + IN.KEY$
3371  DEBUG.LINE = 3380
3372  GOSUB 940
3380  RETURN
3390  'PROCEDURE IN.DEL.CHAR            'Handle backspace key in input
3391  DEBUG.LINE = 3390 : DEBUG.LABEL$ = "IN.DEL.CHAR"
3392  GOSUB 800
3400  IN.CUR.COL = POS(0)
3410  IF NOT(IN.CUR.COL > IN.START.COL) THEN 3460
3420  IN.INPUT$ = LEFT$(IN.INPUT$,LEN(IN.INPUT$)-1)
3430  PRINT " ";
3440  LOCATE ,IN.CUR.COL-1
3450  GOTO 3470
3460  BEEP
3461  DEBUG.LINE = 3470
3462  GOSUB 940
3470  RETURN
3480  'PROCEDURE IN.CURSOR                'Simulate BASIC cursor
3481  DEBUG.LINE = 3480 : DEBUG.LABEL$ = "IN.CURSOR"
3482  GOSUB 800
3490  IF NOT(IN.CURCNT = IN.BLINK) THEN 3550
3500  IF NOT(IN.CURCHAR$ = CHR$(&H5F)) THEN 3530
3510  IN.CURCHAR$ = " "
3520  GOTO 3540
3530  IN.CURCHAR$ = CHR$(&H5F)
3540  IN.CURCNT = 0
3550  PRINT IN.CURCHAR$;
3560  IN.CURCNT = IN.CURCNT + 1
3570  LOCATE ,POS(0)-1
3571  DEBUG.LINE = 3580
3572  GOSUB 940
3580  RETURN
3590  '       SCREEN.INC: a set of sample screen formatting routines
3600  '                    (C) Copyright 1983 Marty Franz
3610  'PROCEDURE INITIALIZE.SCREEN 'Initialize all the screen variables
3611  DEBUG.LINE = 3610 : DEBUG.LABEL$ = "INITIALIZE.SCREEN"
3612  GOSUB 800
3620  BORDER$ = STRING$(80,&HC4)
3630  LINE.MASK$ = SPACE$(79)
3640  MSG.MASK$ = SPACE$(20)
3641  DEBUG.LINE = 3650
3642  GOSUB 940
3650  RETURN
3660  'PROCEDURE CLEAR.SCREEN        'Clear the screen, set keys off
3661  DEBUG.LINE = 3660 : DEBUG.LABEL$ = "CLEAR.SCREEN"
3662  GOSUB 800
3670  KEY OFF : CLS : WIDTH 80
3671  DEBUG.LINE = 3680
3672  GOSUB 940
3680  RETURN
3690  'PROCEDURE SET.TITLES        'Redisplay all the titles
3691  DEBUG.LINE = 3690 : DEBUG.LABEL$ = "SET.TITLES"
3692  GOSUB 800
3700  GOSUB 3660
3710  LOCATE 1,1                     : PRINT L.TITLE$;
3720  LOCATE 1,80-LEN(R.TITLE$)+1     : PRINT R.TITLE$;
3730  LOCATE 3,1                     : PRINT BORDER$
3731  DEBUG.LINE = 3740
3732  GOSUB 940
3740  RETURN
3750  'PROCEDURE SET.FUNCTION.MSG    'Update the function message
3751  DEBUG.LINE = 3750 : DEBUG.LABEL$ = "SET.FUNCTION.MSG"
3752  GOSUB 800
3760  LOCATE 2,1
3770  PRINT LEFT$(FUNC.MSG$+MSG.MASK$,20);
3771  DEBUG.LINE = 3780
3772  GOSUB 940
3780  RETURN
3790  'PROCEDURE SET.ACTION.MSG    'Update the action message
3791  DEBUG.LINE = 3790 : DEBUG.LABEL$ = "SET.ACTION.MSG"
3792  GOSUB 800
3800  LOCATE 2,61
3810  PRINT RIGHT$(MSG.MASK$+ACT.MSG$,20);
3811  DEBUG.LINE = 3820
3812  GOSUB 940
3820  RETURN
3830  'PROCEDURE CLEAR.AREA        'Clear lines 4 thru 23
3831  DEBUG.LINE = 3830 : DEBUG.LABEL$ = "CLEAR.AREA"
3832  GOSUB 800
3840  LOCATE 4,1
3850  FOR CLRA.I = 4 TO 23
3860  PRINT LINE.MASK$
3870  NEXT CLRA.I
3871  DEBUG.LINE = 3880
3872  GOSUB 940
3880  RETURN
3890  'PROCEDURE SET.LINE.24        'Put a message on line 24
3891  DEBUG.LINE = 3890 : DEBUG.LABEL$ = "SET.LINE.24"
3892  GOSUB 800
3900  LOCATE 24,1
3910  PRINT LINE.24.MSG$;
3911  DEBUG.LINE = 3920
3912  GOSUB 940
3920  RETURN
3930  'PROCEDURE CLEAR.LINE.24        'Clear the 24th line of the screen
3931  DEBUG.LINE = 3930 : DEBUG.LABEL$ = "CLEAR.LINE.24"
3932  GOSUB 800
3940  LINE.24.MSG$ = LINE.MASK$
3950  GOSUB 3890
3951  DEBUG.LINE = 3960
3952  GOSUB 940
3960  RETURN
3970  'PROCEDURE DRAW.BOX            'Draw a box
3971  DEBUG.LINE = 3970 : DEBUG.LABEL$ = "DRAW.BOX"
3972  GOSUB 800
3980  LOCATE BOX.ROW,BOX.COL
3990  PRINT CHR$(&HDA);STRING$(BOX.LEN-2,&HC4);CHR$(&HBF)
4000  LOCATE ,BOX.COL
4010  FOR BOX.I=1 TO BOX.HT-2
4020  PRINT CHR$(&HB3);SPACE$(BOX.LEN-2);CHR$(&HB3)
4030  LOCATE ,BOX.COL
4040  NEXT BOX.I
4050  PRINT CHR$(&HC0);STRING$(BOX.LEN-2,&HC4);CHR$(&HD9)
4051  DEBUG.LINE = 4060
4052  GOSUB 940
4060  RETURN
4070  'PROCEDURE DRAW.FRAME        'Draw a frame (double lines)
4071  DEBUG.LINE = 4070 : DEBUG.LABEL$ = "DRAW.FRAME"
4072  GOSUB 800
4080  LOCATE FRAME.ROW,FRAME.COL
4090  PRINT CHR$(&HC9);STRING$(FRAME.LEN-2,&HCD);CHR$(&HBB)
4100  LOCATE ,FRAME.COL
4110  FOR FRAME.I = 1 TO FRAME.HT-2
4120  PRINT CHR$(&HBA);SPACE$(FRAME.LEN-2);CHR$(&HBA)
4130  LOCATE ,FRAME.COL
4140  NEXT FRAME.I
4150  PRINT CHR$(&HC8);STRING$(FRAME.LEN-2,&HCD);CHR$(&HBC)
4151  DEBUG.LINE = 4160
4152  GOSUB 940
4160  RETURN
4170  'PROCEDURE MAIN
4171  DEBUG.LINE = 4170 : DEBUG.LABEL$ = "MAIN"
4172  GOSUB 800
4180  GOSUB 3610
4190  GOSUB 2950
4200  L.TITLE$ = "CHARS - Display the IBM PC Character Set"
4210  R.TITLE$ = "Rascal version 1.05"
4220  GOSUB 3690
4230  FUNC.MSG$ = "Rascal Example #1"
4240  GOSUB 3750
4250  GOSUB 4320
4260  GOSUB 3690
4270  GOSUB 3750
4280  GOSUB 4420
4290  GOSUB 4510
4300  GOSUB 4580
4301  DEBUG.LINE = 4310
4302  GOSUB 940
4310  RETURN
4320  'PROCEDURE GET.DISPLAY.TYPE
4321  DEBUG.LINE = 4320 : DEBUG.LABEL$ = "GET.DISPLAY.TYPE"
4322  GOSUB 800
4330  LOCATE 5,1 : PRINT "Is this a color-graphics display? ";
4340  GOSUB 2990
4350  IF NOT(ANSWER = YES) THEN 4380
4360  SEGVAL! = &HB800    'Color segment
4370  GOTO 4390
4380  SEGVAL! = &HB000    'Monochrome segment
4390  DEF SEG = SEGVAL!
4400  PRINT
4401  DEBUG.LINE = 4410
4402  GOSUB 940
4410  RETURN
4420  'PROCEDURE BORDERS
4421  DEBUG.LINE = 4420 : DEBUG.LABEL$ = "BORDERS"
4422  GOSUB 800
4430  FOR HEX.DIGIT% = 0 TO 15
4440  LOCATE 6,HEX.DIGIT% * 3 + 14
4450  PRINT HEX$(HEX.DIGIT%)
4460  LOCATE HEX.DIGIT%+8,8
4470  PRINT HEX$(HEX.DIGIT%)
4480  NEXT HEX.DIGIT%
4490  LOCATE ,,0
4491  DEBUG.LINE = 4500
4492  GOSUB 940
4500  RETURN
4510  'PROCEDURE BUILD.DISPLAY.ARRAY
4511  DEBUG.LINE = 4510 : DEBUG.LABEL$ = "BUILD.DISPLAY.ARRAY"
4512  GOSUB 800
4520  FOR ROW% = 0 TO 15
4530  FOR COL% = 0 TO 15
4540  POKE (ROW%+7)*160+COL%*6+26, COL%+ROW%*16
4550  NEXT COL%
4560  NEXT ROW%
4561  DEBUG.LINE = 4570
4562  GOSUB 940
4570  RETURN
4580  'PROCEDURE FINISH
4581  DEBUG.LINE = 4580 : DEBUG.LABEL$ = "FINISH"
4582  GOSUB 800
4590  LINE.24.MSG$ = "Press any key to return to DOS..."
4600  GOSUB 3890
4610  GOSUB 3280
4620  GOSUB 3660
4630  SYSTEM
4631  DEBUG.LINE = 4640
4632  GOSUB 940
4640  RETURN